home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / lib / perl / 5.10.0 / Hash / Util.pm
Encoding:
Perl POD Document  |  2009-06-26  |  4.4 KB  |  192 lines
  1. package Hash::Util;
  2.  
  3. require 5.007003;
  4. use strict;
  5. use Carp;
  6. use warnings;
  7. use warnings::register;
  8. use Scalar::Util qw(reftype);
  9.  
  10. require Exporter;
  11. our @ISA        = qw(Exporter);
  12. our @EXPORT_OK  = qw(
  13.                      fieldhash fieldhashes
  14.  
  15.                      all_keys
  16.                      lock_keys unlock_keys
  17.                      lock_value unlock_value
  18.                      lock_hash unlock_hash
  19.                      lock_keys_plus hash_locked
  20.                      hidden_keys legal_keys
  21.  
  22.                      lock_ref_keys unlock_ref_keys
  23.                      lock_ref_value unlock_ref_value
  24.                      lock_hashref unlock_hashref
  25.                      lock_ref_keys_plus hashref_locked
  26.                      hidden_ref_keys legal_ref_keys
  27.  
  28.                      hash_seed hv_store
  29.  
  30.                     );
  31. our $VERSION    = 0.07;
  32. require DynaLoader;
  33. local @ISA = qw(DynaLoader);
  34. bootstrap Hash::Util $VERSION;
  35.  
  36. sub import {
  37.     my $class = shift;
  38.     if ( grep /fieldhash/, @_ ) {
  39.         require Hash::Util::FieldHash;
  40.         Hash::Util::FieldHash->import(':all'); # for re-export
  41.     }
  42.     unshift @_, $class;
  43.     goto &Exporter::import;
  44. }
  45.  
  46. sub lock_ref_keys {
  47.     my($hash, @keys) = @_;
  48.  
  49.     Internals::hv_clear_placeholders %$hash;
  50.     if( @keys ) {
  51.         my %keys = map { ($_ => 1) } @keys;
  52.         my %original_keys = map { ($_ => 1) } keys %$hash;
  53.         foreach my $k (keys %original_keys) {
  54.             croak "Hash has key '$k' which is not in the new key set"
  55.               unless $keys{$k};
  56.         }
  57.  
  58.         foreach my $k (@keys) {
  59.             $hash->{$k} = undef unless exists $hash->{$k};
  60.         }
  61.         Internals::SvREADONLY %$hash, 1;
  62.  
  63.         foreach my $k (@keys) {
  64.             delete $hash->{$k} unless $original_keys{$k};
  65.         }
  66.     }
  67.     else {
  68.         Internals::SvREADONLY %$hash, 1;
  69.     }
  70.  
  71.     return $hash;
  72. }
  73.  
  74. sub unlock_ref_keys {
  75.     my $hash = shift;
  76.  
  77.     Internals::SvREADONLY %$hash, 0;
  78.     return $hash;
  79. }
  80.  
  81. sub   lock_keys (\%;@) {   lock_ref_keys(@_) }
  82. sub unlock_keys (\%)   { unlock_ref_keys(@_) }
  83.  
  84. sub lock_ref_keys_plus {
  85.     my ($hash,@keys)=@_;
  86.     my @delete;
  87.     Internals::hv_clear_placeholders(%$hash);
  88.     foreach my $key (@keys) {
  89.         unless (exists($hash->{$key})) {
  90.             $hash->{$key}=undef;
  91.             push @delete,$key;
  92.         }
  93.     }
  94.     Internals::SvREADONLY(%$hash,1);
  95.     delete @{$hash}{@delete};
  96.     return $hash
  97. }
  98.  
  99. sub lock_keys_plus(\%;@) { lock_ref_keys_plus(@_) }
  100.  
  101. sub lock_ref_value {
  102.     my($hash, $key) = @_;
  103.     # I'm doubtful about this warning, as it seems not to be true.
  104.     # Marking a value in the hash as RO is useful, regardless
  105.     # of the status of the hash itself.
  106.     carp "Cannot usefully lock values in an unlocked hash"
  107.       if !Internals::SvREADONLY(%$hash) && warnings::enabled;
  108.     Internals::SvREADONLY $hash->{$key}, 1;
  109.     return $hash
  110. }
  111.  
  112. sub unlock_ref_value {
  113.     my($hash, $key) = @_;
  114.     Internals::SvREADONLY $hash->{$key}, 0;
  115.     return $hash
  116. }
  117.  
  118. sub   lock_value (\%$) {   lock_ref_value(@_) }
  119. sub unlock_value (\%$) { unlock_ref_value(@_) }
  120.  
  121. sub lock_hashref {
  122.     my $hash = shift;
  123.  
  124.     lock_ref_keys($hash);
  125.  
  126.     foreach my $value (values %$hash) {
  127.         Internals::SvREADONLY($value,1);
  128.     }
  129.  
  130.     return $hash;
  131. }
  132.  
  133. sub unlock_hashref {
  134.     my $hash = shift;
  135.  
  136.     foreach my $value (values %$hash) {
  137.         Internals::SvREADONLY($value, 0);
  138.     }
  139.  
  140.     unlock_ref_keys($hash);
  141.  
  142.     return $hash;
  143. }
  144.  
  145. sub   lock_hash (\%) {   lock_hashref(@_) }
  146. sub unlock_hash (\%) { unlock_hashref(@_) }
  147.  
  148. sub lock_hashref_recurse {
  149.     my $hash = shift;
  150.  
  151.     lock_ref_keys($hash);
  152.     foreach my $value (values %$hash) {
  153.         if (reftype($value) eq 'HASH') {
  154.             lock_hashref_recurse($value);
  155.         }
  156.         Internals::SvREADONLY($value,1);
  157.     }
  158.     return $hash
  159. }
  160.  
  161. sub unlock_hashref_recurse {
  162.     my $hash = shift;
  163.  
  164.     foreach my $value (values %$hash) {
  165.         if (reftype($value) eq 'HASH') {
  166.             unlock_hashref_recurse($value);
  167.         }
  168.         Internals::SvREADONLY($value,1);
  169.     }
  170.     unlock_ref_keys($hash);
  171.     return $hash;
  172. }
  173.  
  174. sub   lock_hash_recurse (\%) {   lock_hashref_recurse(@_) }
  175. sub unlock_hash_recurse (\%) { unlock_hashref_recurse(@_) }
  176.  
  177. sub hashref_unlocked {
  178.     my $hash=shift;
  179.     return Internals::SvREADONLY($hash)
  180. }
  181.  
  182. sub hash_unlocked(\%) { hashref_unlocked(@_) }
  183.  
  184. sub legal_keys(\%) { legal_ref_keys(@_)  }
  185. sub hidden_keys(\%){ hidden_ref_keys(@_) }
  186.  
  187. sub hash_seed () {
  188.     Internals::rehash_seed();
  189. }
  190.  
  191. 1;
  192.